perm filename NTSB.F4[P11,LCS] blob
sn#583800 filedate 1981-05-02 generic text, type T, neo UTF8
00100 ******* FOR NOTE DRAWING, RESTS ACCENT AND OTHER MARKS.
00200 SUBROUTINE NOTWRT
00300 IMPLICIT INTEGER(A-Q,S-Z)
00400 COMMON/DL/IXRX,M,AA /FONT/JFONT
00500 COMMON/DAT/RACNT(69),RDOT(17),XAC(7),RNOTE(22),RACCI(22),NACCI(3)
00600 REAL DIS,CENTR,POS,STFF,XDIS
00700 COMMON /LIMIT/LIMIT,ITEM,L,I,IX,ITEMX /STF/RSTFAC(0/7),RSTJ2
00800 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
00900 COMMON/PLTR/PLT,RHT,DIS,XDIS /POSI/STFF(0/7),JJ2,POS
01000 C ITEMS IN FOLLOWING COMMON BLOCK ARE USED IN 'TAILS' AND 'FERM'
01100 COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
01200 1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,J5X,RXX,JJJ,
01300 1 PUNCT,JY,RJ
01400 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R4,RJQ(2))
01500 1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8)),
01600 1(J11,JQ(9)),(J6,JQ(4)),(R5,RJQ(3)),(R11,RJQ(9)),(JSTEM,JQ(20))
01700 1,(R8,RJQ(6)),(R7,RJQ(5)),(RX,JRX),(RJZ,RJQ(20)),(R3,RJQ(1))
01800 1,(RX4,JQ(19))
01900
02000 RSTX=RSTJ2
02100 C FOR MINIS AT 245
02200 RMINI=RSTJ2
02300 C OR SHOULD THIS ONLY BE IN NOTES, ETC? 15/9/72
02400 RST7=7.*RSTJ2
02500 RINV=1.
02600 RX4=R4
02700 IF(JA.EQ.1)GO TO 11
02800 IF(JA.EQ.9)GO TO 242
02900 C NEXT IS FOR RESTS
03000 IF(IABS(J4).LT.480)GO TO 302
03050 CALL EXTRA
03100 C P4+500= USER-ADDED RESTS
03200 RETURN
03400 302 IF(J6.LT.0)RETURN
03500 C J6=-1= INVIS. RESTS NEEDED IN 'PARTS' PROGRAM
03550 IF(R9.GT.0)GO TO 3302
03600 CX IF(R9.GT.0)R3=RHORZ(R9)
03650 J9=0
03700 C USE R9 FOR CENTERING. ORIG. P3 IS BASIC POS.
03800 C J9=0 NEEDED FOR CENTERED ./. REPEAT SIGN.**********
03900 C IF R9<0 CENTERING WILL BE DONE IN RSTCEN
04100 IF(R9.GT.0)GO TO 4302
04150 CALL RSTCEN
04650 4302 R3=RHORZ(R9)
04660 C R9=0 SO LEDGER LINE FEATURE DOESN'T GET CONFUSED.
04675 R9=0
04700 302 IF(R8.EQ.-3)R8=0
04800 IF(R8.NE.0.AND.J5.NE.-3)J5=-2
04900 C R8=-4 OR -5 MAKES REPEAT BAR SIGN
05000 C R8=-3 IS FOR 'PAGE' PROGRAM
05100 C SO THAT REST SHAPES ARE NOT CHANGED IN FULL BAR REST.
05200 C R8 PUTS NUM OVER WHL RST ONLY. R5=-3 PUTS DBL WHL UNDER REST.
05300 IF(J5.GT.1)R4=R4-2.
05400 R7=R6*10.
05500 C FOR DOTS
05600 IF(J5.GE.2)R3=R3-3.0*RSTJ2
05700 C SHIFTS 1/16 AND SMALLER RESTS .5 TO LEFT
05750 202 CALL REST
05800 IF(J5.GT.1)GO TO 200
05900 IF(R7.EQ.0)RETURN
06000 201 RA=14.
06100 R6=0
06200 IF(J5.LT.0)RA=19.
06300 R3=R3+RA*RSTJ2
06400 R4=8.+R4
06500 JA=9
06600 J5=7
06700 C P6=1 THE REST IS DOTTED
06750 CALL CENTX
06800 GO TO 242
06900 200 J5=J5-1
07000 C FOR MULTIPLE TAILS ON 16TH REST, ETC.
07100 R4=R4+2.
07200 CALL RJBX(4.3)
07300 GO TO 202
07400 29 RJX=R3
07500 RJY=CENTR+RSTJ2
07600 CC108 IF(WHOLE.NE.0)RJX=RJX+3.*RMINI
07610 108 IF(JY.NE.0)RJX=RJX+3.*RMINI
07700 C JY(WHOLE)=1 MEANS IT'S A WHOLE NOTE (WIDER THAN A HALF.)
07750 JY=0
07800 RG=9.
07900 IF(PLT.LT.0)RG=17.
08000 C DOESN'T FILL DOT ON DPY
08050 107 CALL RDRAW(1,RG,RDOT,RMINI,RJX,RJY,RMINI)
08100 IF(JA.EQ.1)GO TO 290
08200 IF(R7.GE.20.)GO TO 290
08300 RB=POS+52.*RSTJ2
08400 IF(RJY.NE.RB)GO TO 6241
08500 C WHERE IS RB USED LATER?
08600 RJY=RJY-12.*RSTJ2
08700 GO TO 107
08800 C ABOVE FOR DOTS
08900 290 R7=R7-10.
09000 IF(R7.LT.10.)GO TO 1342
09100 RJX=RJX+RSTJ2*10.
09200 GO TO 107
09300 C NOTES****
09400 11 CALL NTS
09500 IF(JSTEM.LT.0)RETURN
09600 R4=RX4
09700 242 IF(R7.LT.10.)GO TO 1342
09800 C FOR DOTTED NOTE-- P7>9
09900 RJX=RJAC+(22.+AMOD(R7,1.0)*59.6)*RMINI
10000 C***↑↑↑↑↑ WAS 24. 11/74
10100 RJY=CENTR+RSTJ2
10200 C TO USE LATER
10300 IF(R7.LT.100)GO TO A12
10400 C SAVE +100 OR -100 IN AC3
10500 R7=R7-100
10600 C ADD 100 TO R7 TO PUT DOT BELOW NOTE.
10700 C SKIP NEXT IF JY=20 (NOTE TO LFT OF STEM)
10800 C [14.54] ; RJX=RJX+14.54
10900 IF(JY.EQ.10)RJX=RJX+14.54
11000 4322 RJX=RJX+RSTM
11100 C PUT AWAY RJX
11200 C MOVES DOT TO LEFT
11300 3322 IF(MOD(J4,2).EQ.0)GO TO 108
11400 RX=RST7
11500 IF(JY.GE.20)RX=-RX
11600 RX=-RX
11700 C ADD 100 TO R7 FOR DOTS BELOW! NOTE
11800 3342 RJY=RJY+RX
11900 GO TO 108
12000 1342 IF(J5.NE.0)GO TO 5322
12100 IF(R6.EQ.0)RETURN
12200 5322 R3=R3-R5*59.6*RMINI
12300 C TO SPACE OUT ACCIDS.
12400 242 IF(J5.GE.0)GO TO 2421
12500 RINV=-RINV
12600 J5=-J5
12700 C NOW THAT 0 NOT USED FOR DOTS, ABOVE 3 LINES COULD BE CHNGD
12800 JAX=JA
12900 C FLAG FOR 'TS' COMBO TS=-1 OR CODE NUM.
13000 C USED AT 4241 FOR DOUBLE MARKS ON NOTES.
13100 IF(JA.EQ.9)GO TO 2423
13200 IF(J5.GT.3)GO TO 3121
13300 GO TO 211
13400 C FOR 'DRWNT' WHEN PLOTTING.
13500 CALL NOZERO(R6)
13600 C R6=SIZE FACTOR (P6)
13700 R6=0
13800 JSTEM=0
13900 C FOR MISC. ITEMS
14000 210 IF(IABS(J4).LT.100)GO TO 1241
14100 J4=MOD(J4,100)
14200 RMINI=.7*RMINI
14300 C FOR 2 MARKS AT ONCE.
14400 1241 IF(J5.GE.11)GO TO 28
14500 GO TO (211,211,211,28,28,222,249,60,27,27),J5
14600 RETURN
14700 C ERROR TRAP (I.E. J5=0)
14800 RETURN
14900 241 CALL LINES(R3,CENTR,3)
15000 GO TO 210
15100 211 IF(J5.EQ.0)GO TO 2422
15200 C GETS BACK GOOD VERTICAL POS.
15300 IF(J5.GT.3)GO TO 222
15400 C FOR 2-PASS PLOTTING (-2=THIN LINES, -3=HEAVY LINES)
15500 IF(PLT)GO TO 3121
15600 IF(JFONT.NE.0)GO TO 3121
15700 X=NACCI(J5)
15800 2422 IF(R6.EQ.0)RETURN
15900 IF(R6.GT.0)GO TO B24
16000 X=AMOD(R12,1.0) GET THE VERT. SPACE, IF ANY.
16100 C R11=1407.2 MEANS 'PLUS & DOT UP 2 STEPS'.
16200 C R11 INFOR WILL OVER RIDE R6 INFO!!!
16300 C X*10*7 (7 UNITS PER BASIC VERTICAL STEP.)
16400 C R11 NOW HAS VERTICAL DISPLACEMENT
16500 C REMAINDER WILL BE IN AC1 (RIGHT 2 DIGITS)
16600 C IF(FIRST NUM=27 OR 28)DO NEXT (EXCH POSITIONS)
16700 C EG. 2712 CHANGES TO 1227 (SO IT WORKS)
16800 C ALL THIS FOR TEN.-STAC. COMBO (=27) ALSO WEDGE-STAC.
16900 J11=AC1*100+AC0
17000 C NOW ALL EXCHANGED.
17100 IF(AC1.GE.10)AC1=AC1*10
17200 C GET THE CORRECT MARK NUMBERS BELOW
17300 IF(R6.LT..1)RETURN 4/76
17400 C SO UP TO .0099 CAN BE PUT IN P6 FOR 'EXTRA'
17500 J5=(R6+.001)*100.
17600 R4=RX4
17700 R3=RJAC
17800 1249 IF(MOD(J5,10).GT.3)GO TO 249
17900 C SETZM FICTA ;FICTA=0 MUSICA FICTA FLAG. NEEDED AT AALPH:
18000 J5=J5/10
18100 IF R6.LT.0 SDTHEN CHANGE 1 TO 22, 2 → 23, ETC.
18200 C FOR MUSICA FICTA NUMS.1,2,3=FLT,#,NAT
18300 FICTA=-1
18400 C 29 STILL OPEN FOR MARKS IN SUBR. FERMTA
18500 IF(J5.GT.39)GO TO 1249
18600 C WHEN P1=1, EXTRACTS ACCENT NUMBERS FROM DECIS IN P6.
18700 249 IF(J5.GT.30)GO TO 28
18800 IF(J5.GT.10)GO TO 246
18900 IF(J5.EQ.0)RETURN
19000 IF(JA.NE.1)GO TO 250
19100 RB=14.
19200 C R11 WILL BE 0 IF R6 HAD MARKS INFO
19300 IF(MOD(J4,2).EQ.0)GO TO 244
19400 IF(J5.EQ.7)GO TO 6322
19500 IF(J5.NE.9)GO TO 244
19600 6322 IF(JSTEM.GT.1)GO TO 7322
19700 IF(J4.LT.5)GO TO 244
19800 7322 IF(J4.LE.9)GO TO 8322
19900 IF(JSTEM.EQ.2)GO TO 244
20000 IF(JSTEM.EQ.0)GO TO 244
20100 8322 RB=21
20200 244 IF(JSTEM.EQ.1)GO TO 9322
20300 IF(JSTEM.NE.0)GO TO 245
20400 IF(J4.GE.7)GO TO 245
20500 9322 RB=-RB
20600 245 CENTR=CENTR+RB*RSTX
20700 C R11= THE VERT. DISPLACEMENT
20800 250 IF(J5.GT.10)GO TO 281
20900 IF(J5.LT.6)GO TO 281
21000 JA=9
21100 IF(J5.NE.7)GO TO 253
21200 C 7=DOT
21300 RXX=R3
21400 R3=R3+6.7*RMINI
21500 C CENTERS THE DOT
21600 GO TO 29
21700 253 IF(J5.EQ.9)GO TO 271
21800 C 9=DASH
21900 251 IF(RB.LT.0)RINV=-RINV
22000 C FIX THIS!!!! FOR BOWINGS, ETC.
22100 C GET DISPLACEMENT IN SCALE STEPS
22200 C ADD TO HEIGHT
22300 IF(JSTEM.EQ.1)R11=-R11 FOR WEDGE
22400 C MUSICA FICTA FLAG (J5=21,22,23 SAME AS TR.)
22500 2222 IF(J5.LT.20.OR.J5.GT.23)GO TO 2223
22600 JA=7
22700 R5=0
22800 J7=1
22900 CALL ALPHA
23000 R8=J5-50 (R8=1=FLT, 2=SHRP, 3=NAT)
23100 C FOR TRILL -- J5=20
23200 C MUSICA FICTA FLAG
23300 C RESET FICTA FLAG
23400 2223 IF(J5.EQ.17)GO TO 323
23500 IF(J5.NE.18)GO TO 222
23600 323 RINV=J5
23700 C FLOAT IT.
23800 C FOR MORD, INV.MORD
23900 GO TO 5241
24000 246 IF(J5.LT.10)GO TO 245
24100 C FOR COMBOS. TS=27, WS=28, AS=29.
24200 IF(J5.LT.27.OR.J5.GT.30)GO TO AB246
24300 C TS IS FLAG FOR COMBOS
24400 C STACCATO COMES FIRST IN COMBOS
24500 C CAIN =28 ;WS COMBO =28
24600 JRST AC246
24700 CAIE =27 ;TS COMBO =27
24800 JRST AB246 ;IF(J5.NE.27)GO TO AB246
24900 AA246: MOVEI =9 ;TEN. COMES 1ST IF TEN.-STAC. COMBO
25000 SKIPA
25100 AC246: MOVEI =7 ;STAC. COMES 1ST IF WEDGE-STAC. COMBO
25200 MOVEM TS ;TS=CODE FLAG
25300 JRST ATS ; AC0=9 SETUP TENUTO FIRST
25400 RZ=3
25500 C IS IT A FERMATA? IF(J5.EQ.26)RZ=2
25600 C RZ=2 **** MAKE FERMATA 1 LESS AWAY
25700 IF(JSTEM.EQ.1)RZ=9.+R8
25800 C IS IT A FERMATA?
25900 IF(JSTEM.EQ.1)RZ=8.+R8
26000 R4=R4+RZ*RMINI/RSTJ2
26100 C IS IT A FERMATA?
26200 C ;YES, LESS SPACE
26300 IF(R4.LT.11.75)R4=11.75
26400 ; CAML 2,[11.75] ; 45100 IF(R4.LT.11.75)R4=11.75
26500 2/81 CAML 2,[12.5] ; 45100 IF(R4.LT.12.5)R4=12.5
26600 ; JRST .+3
26700 ; MOVSI 02,204620
26800 ; CAIN 0,=26 ;IS IT A FERMATA?
26900 ; MOVSI 02,204570 ;11.75
27000 ; MOVEM 02,R4 ; 45200 CALL CENTX
27100 CALL CENTX
27200 IF(J5.EQ.26)GO TO 222
27300 C R11=DISPLACEMENT
27400 C 26 IS NEW NUMB FOR FERMATA.
27500 IF(J5.LT.30)GO TO 281
27600 C PRINTS ONLY NUMS 0→5 AS FINGERINGS OVER NOTES.
27700 IF(J5.GE.36)GO TO A28X
27800 R5=J5-30 GET THE 1 DIGIT NUM.
27900 R6=.75 SIZE OF NUM.
28000 IF(JSTEM.EQ.1) SHIFT 2 TO RIGHT
28100 JX3=JX3+RSTJ2*6.0 GET REAL R3 BACK,PUSH LEFT.
28200 R7=0
28300 R8=0
28400 R9=0
28500 RA=2.5
28600 IF(JSTEM.EQ.2)RA=-RA
28700 C GET J4 (R4 AND RX4 GET CHANGED IN TAILS)
28800 R4=J4+RA HGT OF NUM.
28900 CALL MAKNUM(R5)
29000 C ADD HERE FOR NUMS WITH ACCENTS, ETC.
29100 J5X=MOD(J5,10)
29200 C J5X SAVES NEXT MARK.
29300 IF(J5X.LT.4)J5X=0
29400 J5=J5/10
29500 IF(J5.GT.30)RETURN
29600 C WON'T READ 415 ETC. (CORRECT=154)
29700 CALL EXCH(J5X,J5)
29800 C PUTS UPBOW, DNBOW, ETC. ABOVE STACC., ETC.
29900 IF(JA.EQ.1)GO TO 249
30000 GO TO 1241
30100 281 X=1
30200 IF(J5.GT.16)GO TO 2222
30300 C JUMP FOR MORD, INV.MORD, TRILL
30400 IF(J5.NE.4)GO TO 228
30500 X=5
30600 CALL RJBX(.5)
30700 GO TO 328
30800 228 IF(J5.GT.10)X=XAC(J5-10)
30900 C X IS POINTER IN RACNT ARRAY
31000 328 RA=RMINI
31100 C OR RSTJ2?
31200 IF(RINV.LT.0)GO TO 1323
31300 IF(JSTEM.NE.1)GO TO 2323
31400 IF(J5.NE.4)GO TO 2323
31500 1323 RA=-RA
31600 C ↑↑↑ X ↑↑↑ PICKS UP TYPO ERRORS
31700 JTH=0
31800 IF(IPLT.GE.0)GO TO AA1
31900 JTH=-2
32000 RJJJ=CENTR+R11 (DISPLACEMENT UNIT)
32100 C PTR, WDCNT, ARRAY,Y MULT,HOR ADD,VERT ADD, X,Y,MULT
32200 IF(JTH.GE.0) GO TO 5241
32300 4241 JJJ=J5
32400 JTH=JTH-1
32500 IF(J5.NE.13)GO TO AA27 13=HARMONIC
32600 RMINI=RMINI+.02
32700 IF(J5.EQ.14)R3=R3+XDIS 14= +
32800 CENTR=CENTR-XDIS TO THICKEN > - ∧ ETC. WHEN PLOTTING
32900 GO TO AA1
33000 J5=J5X
33100 J5X=-1
33200 IF(JAX.NE.1)GO TO 7241
33300 IF(J5.GT.10)GO TO 246
33400 IF(J5.NE.7)GO TO 7241
33500 IF(JJJ.NE.9)GO TO 249
33600 7241 RXX=8.5*RMINI
33700 7241 RXX= 8.5*RMINI
33800 IF(J5.EQ.5)RXX=10.5*RMINI
33900 C ACC. IS FARTHER FROM STAC. THAN WEDGE OR TEN.
34000 C THIS IS FOR COMPOSITE MARKS (TEN.-STAC. ETC)
34100 IF(JSTEM.EQ.1)RXX=-RXX
34200 CENTR=CENTR+RXX
34300 IF(J5.EQ.26)J5=6
34400 C TEMPORARY?? FIX
34500 C >=5, ↑=4
34600 C DASHES
34700 271 CALL LINX(R3,CENTR,R3+RMINI*14.,CENTR)
34800 C MAKE THICKER IF PLOTTING
34900 CENTR=CENTR-XDIS (1/DIS)
35000 IF(J11.EQ.0)GO TO B5241
35100 IF(TS.EQ.CODE)AC0=7, RESET TS, GO TO B421
35200 IF(TS.EQ.7)J5=4 ('WS' COMBO)
35300 C GO ARRANGE THE HEIGHT SHIFT
35400 C NOW GET TENUTO (=9)
35500
35600 IF(TS.EQ.28)NEXT IS WEDGE (FOR WS)
35700 IF(TS.EQ.29)NEXT IS ACCENT (FOR AS)
35800 C GO ARRANGE THE HEIGHT SHIFT
35900 J11=0 SO IT WILL PASS HERE SECOND TIME AROUND.
36000 R11=0 SO DOUBLE MARKS WON'T BE MOVED UP TWICE.
36100 GO TO B4241
36200 5241 IF(J5X.GT.0)GO TO 4241
36300 C J5X IS FOR DOUBLE MARKS.(WHAT ABOUT DOT POSITION.)
36400 6241 R3=RXX
36500 C RESET R3 AFTER A DOT.
36600 3121 J5=J5+9
36700 C SOON WILL HAVE DBL FLAT (4) AND DBL SHRP (5)
36800 GO TO 2422
36900 END
37000
37100 SUBROUTINE RSTCEN
37200 C FOR CENTERING WHOLE RESTS
37300 C IF(ITEMX.GT.ITEM) USE ITEMX FOR RANGE INSTEAD
37350 INTEGER PLT
37400 COMMON R2,JA,CNTR,J2,R3,RJQ(5),R9,RJ(12),RX3
37500 1/LIMIT/LM,ITEM,L,I,IX /STF/RF(8),RSTJ2 /XRN/RN(1)
37600 C R9 ≠ 0 AND R13 ≠ 0 WILL CENTER THE REST
37700 X=1000.
37800 C FINAL POSITION WILL BE 1/2 WAY FROM 1ST NOTE POS. TO BARLINE.
37900 DO 1 K=1,ITEM
38000 IF(CODN(K,L).NE.4)GO TO 1
38100 IF(RN(L).GT.2.)GO TO 1
38200 C FIND ONLY BARLINES (WDCNT=1)
38300 A=RN(L+3)
38400 IF(A.LT.X.AND.A.GT.RX3)X=A
38500 1 CONTINUE
38600 IF(X.NE.1000.)R9=RX3+(X-RX3)/2.-3.0*RSTJ2
38700 C RX3 HAS IMPORTANT POS. INFO FOR NTS.
38720 IF(PLT.EQ.1)RETURN
38733 IA=I
38746 C GET POINTER FOR MP PROGRAM IF IN PLOT MODE (PLT=-1)
38759 IF(PLT..NE.0)IA=IX
38772 RN(IA-1)=R9
38785 C R9 IS MOST EASILY SET WITH 'CN'(CENTER) COMMAND
38800 END